COMMENT ⊗   VALID 00010 PAGES
C REC  PAGE   DESCRIPTION
C00001 00001
C00002 00002	ss(tdvsbu,Static and dynamic ways of programming.)
C00003 00003	ss(numrec,Recursive definition of functions on natural numbers.)
C00006 00004	ss(listrec,Simple list recursion.)
C00007 00005	ss(sexprec,Simple S-expression recursion.)
C00009 00006	ss(strucrec,Other structural recursions.)
C00011 00007	ss(treerec,General tree recursion.)
C00013 00008	 Non structural recursion
C00014 00009	ss(soln, Solving a LISP programming problem.)
C00017 00010	
C00018 ENDMK
C⊗;
;;;ss(tdvsbu,Static and dynamic ways of programming.)

(DEFUN FACTORIAL (N)
  (COND ((EQUAL N 0) 1) (T (TIMES N (FACTORIAL (SUB1 N)))) ))

(DEFUN FACT (N)
  (PROG (I X)
    (SETQ I N)
    (SETQ S 1)
  LOOP		
    (COND ((EQUAL I 0) (RETURN S)) )
    (SETQ S (TIMES I S)
    (SETQ I (SUB1 I))
    (GO LOOP)
  ) ))

(DEFUN FACT1 (I S)
  (COND ((EQUAL I 0) S) (T (FACT1 (SUB1 I) (TIMES I S))) ))

(DEFUN FACT0 (N) (FACT1 N 1))

;;;ss(numrec,Recursive definition of functions on natural numbers.)

(DEFUN %PLUS (N M) 
  (COND ((EQUAL N 0) M) (T (ADD1 (PLUS (SUB1 N) M)))))

(DEFUN DIFFER (N M)
  (COND ((EQUAL N 0) 0) ((EQUAL M 0) N) (T (DIFFER (SUB1 N) (SUB1 M))) ))

(DEFUN %GREATERP (N M)
  (COND ((EQUAL N 0) 0) ((EQUAL M 0) 1) (T (GREATERP (SUB1 N) (SUB1 M))) ))

(DEFUN F1(N)
  (COND ((EQUAL N 0) A)
	(T (H (DIFFERENCE N 1) (F1 (DIFFERENCE N 1))))))

(DEFUN F2(N M)
  (COND ((EQUAL N 0) (G M))
	(T (H (DIFFERENCE N 1) M (F2 (DIFFERENCE N 1) M)))))

(DEFUN F3(N M)
  (COND ((EQUAL N 0) (G M))
	(T (H (DIFFERENCE N 1) M (F3 (DIFFERENCE N 1) (J (DIFFERENCE N 1) M))))))

(DEFUN FIB (N)
  (COND ((EQUAL N 0) 0)
	((EQUAL N 1) 1)
	(T (PLUS (FIB (SUB1 N)) (FIB (SUB1 (SUB1 N))))) ))


;;;⊗⊗⊗fiba[n] ← fibb[n,$$0$,$$1$]                 ⊗
;;;!fcnfib&a 
;;;⊗⊗⊗fibb[n,k,m] ← qif n=$0 qthen k qelse fibb[n-$$1$,m,m+k]⊗

(DEFUN FIBA (N) (FIBB N 0 1))

(DEFUN FIBB (N K M) (COND ((EQUAL N 0) K) (T (FIBB (SUB1 N) M (PLUS K M))) ))

;;;!fcnack& ⊗⊗⊗   ack[m,n] ← qif m=$0 qthen n+$1 qelse qif n=$0 qthen ack[m-$$1$,$$1$]
;;;qelse ack[m-$$1$,ack[m,n-$$1$]]⊗.

(DEFUN ACK (M N)
  (COND ((EQUAL M 0) (ADD1 N))
	((EQUAL N 0) (ACK (SUB1 M) 1))
	(T (ACK (SUB1 M) (ACK M (SUB1 N)))) ))

;;;ss(listrec,Simple list recursion.)

;;;APPEND READIN[206,CLT]

(DEFUN MEMBER% (X U) 
  (COND ((NULL U) NIL) (T (OR (EQUAL X (CAR U)) (MEMBER% X (CDR U)))) ))

;;;REVERSE1 READIN[206,CLT]
;;;LAST READIN[206,CLT]
;;;LENGTH READIN[206,CLT]

;;;ss(sexprec,Simple S-expression recursion.)

;;;SUBST READIN[206,CLT]

;eqnspr1 ⊗⊗⊗f[x] ← qif qat x qthen g[x] qelse h[qa x, qd x, f[qa x], f[qd x]]⊗.
(DEFUN F4(X)
  (COND ((ATOM X) (G X))
	(T (H (CAR X) (CDR X) (F (CAR X)) (F (CDR X))))))

(DEFUN F5(X Y)
  (COND ((ATOM X) (G X Y))
	(T (H (CAR X) (CDR X) Y (F (CAR X)(JA X Y)) (F (CDR X)(JD X Y))))))

(DEFUN SIZE (X) (COND ((ATOM X) 1) (T (PLUS (SIZE (CAR X)) (SIZE (CDR X))))))

(DEFUN EQUAL% (X Y)
  (COND ((ATOM X) (COND ((ATOM Y) (EQ X Y)) (T NIL)))
	((ATOM Y) NIL)
	(T (AND (EQUAL% (CAR X) (CAR Y)) (EQUAL% (CDR X) (CDR Y))))))
;;;FRINGE READIN[206,CLT]
;;;FRINGE READIN[206,CLT]
;;;FLATTEN READIN[206,CLT]

;;;ss(strucrec,Other structural recursions.)

(DEFUN F6 (X Y)
    (COND ((NUM X) (GNUM X Y))
	  ((ISVAR X) (GVAR X Y))
	  ((ISSUM X) (GSUM (S1 X) (S2 X) Y (F (S1 X) Y) (F (S2 X) Y)))
	  ((ISPROD X) (GPROD (P1 X) (P2 X) Y (F (P1 X) Y) (F (P2 X) Y)))))

(DEFUN ISNUM (E) (NUMBERP E))
(DEFUN CVAL (E) E)

(DEFUN ISVAR (E) (AND (NOT (NUMBERP E)) (ATOM E)))
(DEFUN LOOKUP (E A) (CDR (ASSOC E A)))

(DEFUN ISSUM (E) (EQ (CAR E) 'PLUS))
(DEFUN S1 (E) (CADR E))
(DEFUN S2 (E) (CADDR E))
(DEFUN SUM (E1 E2) (PLUS E1 E2))

(DEFUN ISPROD (E) (EQ (CAR E) 'TIMES))
(DEFUN P1 (E) (CADR E))
(DEFUN P2 (E) (CADDR E))
(DEFUN PROD (E1 E2) (TIMES E1 E2))

(DEFUN NVAL (E A)
  (COND ((ISNUM E) (CVAL E))
	((ISVAR E) (LOOKUP E A))
	((ISSUM E) (SUM (NUMVAL (S1 E) A) (NUMVAL (S2 E) A)))
	((ISPROD E) (PROD (NUMVAL (S1 E) A) (NUMVAL (S2 E) A)))))

;;;ss(treerec,General tree recursion.)


(DEFUN SEARCH (P) (COND ((LOSE P) 'LOSE) ((TER P) P) (T (SEARCHLIS (SUCCESSORS P)))))

(DEFUN SEARCHLIS (U) 
  (COND ((NULL U) 'LOSE) 
	(T ((LAMBDA (X) 
	      (COND ((EQ X 'LOSE)(SEARCHLIS (CDR U))) (T X))) (SEARCH (CAR U))))))


(DEFUN LOSE (P) (MEMBER (CAR P) (CDR P)))

(DEFUN TER (P) (EQ (CAR P) FINAL))

(DEFPROP SUCCESSORS 
  (LAMBDA (P) (MAPCAR (FUNCTION (LAMBDA (X) (CONS X P)))
                      (CDR (ASSOC (CAR P) GRAPH))))
S1)

(DEFUN ALLSOL1 (P) (COND ((LOSE P) NIL)
		((TER P) (LIST P))
		(T (MAPAPP (FUNCTION ALLSOL1) (SUCCESSORS P)))))

(DEFUN MAPAPP (FN U) (COND ((NULL U) NIL) (T (APPEND (FN (CAR U)) 
	(MAPAPP FN (CDR U))))))

(DEFUN ALLSOL (P) (ALLSOLA P NIL))

(DEFUN ALLSOLA (P FOUND) (COND
	((LOSE P) FOUND)
	((TER P) (CONS P FOUND))
	(T (ALLSOLB (SUCCESSORS P) FOUND))))

(DEFUN ALLSOLB (U FOUND) (COND
	((NULL U) FOUND)
	(T (ALLSOLB (CDR U) (ALLSOLA (CAR U) FOUND)))))

;;; Non structural recursion
(DEFUN F7 (X) (COND ((P X) (G X)) (T (F (H X)))))

(DEFUN F8 (N) (COND ((EQUAL N 1) 1) ((EVEN N) (F (// N 2))) 
    (T (F8 (PLUS (TIMES 3 N) 1)))))

(DEFUN SACK (X Y) 
    (COND ((ATOM X) (CONS X Y))
	((ATOM Y) (SACK (CAR X) (CDR X)))
	(T (SACK (CDR X) (SACK X (CDR Y))))))

(DEFUN TAK (X Y Z)
    (COND ((GREATERP X Y) (TAK (TAK (DIFFERENCE X 1) Y Z)
			       (TAK (DIFFERENCE Y 1) Z X)
			       (TAK (DIFFERENCE Z 1) X Y)))
	  (T Z)))
;;;ss(soln, Solving a LISP programming problem.)
(DEFUN ALLSUB (U V) (ALLSUB1 U V 1)) 

(DEFUN ALLSUB1 (U V P) 
       (COND ((NULL V) NIL)
	     ((AGREES U V) (CONS P (ALLSUB1 U (CDR V) (ADD1 P))))
	     (T (ALLSUB1 U (CDR V) (ADD1 P))))) 

(DEFUN AGREES (U V) 
       (COND ((NULL U) T)
	     ((NULL V) NIL)
	     (T (AND (EQUAL (CAR U) (CAR V))
		     (AGREES (CDR U) (CDR V)))))) 

(DEFUN ALLPOS (V) (ALLPOS1 V 1))
(DEFUN ALLPOS1 (V N)
  (COND ((NULL V) NIL)
	((ATOM (CAR V)) (CONS (LIST N) (ALLPOS1 (CDR V) (ADD1 N))))
	(T (CONS (LIST N) 
		 (APPEND (TACK N (ALLPOS (CAR V))) (ALLPOS1 (CDR V) (ADD1 N))))) ))

(DEFUN TACK (N W) (COND ((NULL W) NIL) (T (CONS (CONS N (CAR W)) (TACK N (CDR W)))) ))

(DEFUN ALLSUBSUB (U V) (ALLSUBSUB1 U V 1))
(DEFUN ALLSUBSUB1 (U V N)
  (COND ((NULL V) NIL)
	((AGREES U V) (CONS (LIST N) (ALLSUBSUB1 U (CDR V) (ADD1 N))))
	((ATOM (CAR V)) (ALLSUBSUB1 U (CDR V) (ADD1 N)))
	(T (APPEND (TACK N (ALLSUBSUB U (CAR V))) (ALLSUBSUB1 U (CDR V) (ADD1 N)))) ))

(DEFUN ALLPOS% (V) (ALLPOS1% V '(1)))
(DEFUN ALLPOS1% (V P)
  (COND ((NULL V) NIL)
	((ATOM (CAR V))
	 (CONS (REVERSE P) (ALLPOS1% (CDR V) (CONS (ADD1 (CAR P)) (CDR P)))) )
	(T (CONS (REVERSE P) 
	         (APPEND (ALLPOS1% (CAR V) (CONS 1 P)) 
			 (ALLPOS1% (CDR V) (CONS (ADD1 (CAR P)) (CDR P)))))) ))

(DEFUN ALLSUBSUB% (U V) (ALLSUBSUB1% U V '(1)))
(DEFUN ALLSUBSUB1% (U V P)
  (COND ((NULL V) NIL)
	((AGREES U V)
	 (CONS (REVERSE P) (ALLSUBSUB1% U (CDR V) (CONS (ADD1 (CAR P)) (CDR P)))) )
	((ATOM (CAR V)) (ALLSUBSUB1% U (CDR V) (CONS (ADD1 (CAR P)) (CDR P))) )
	(T (APPEND (ALLSUBSUB1% U (CAR V) (CONS 1 P)) 
		   (ALLSUBSUB1% U (CDR V) (CONS (ADD1 (CAR P)) (CDR P))))) ))